source("parsetting.R")

makeAccum <- function(it) {
  # define and return the accumulator function that will be
  # passed to eachElem
  function(results, tags) {
    if (identical(it$error.handling, 'stop') && !is.null(it$state$errorValue))
      return(invisible(NULL))

    for (i in seq(along=tags)) {
      if (it$verbose)
        cat(sprintf('got results for task %d\n', tags[i]))
      accumulate(it, results[[i]], tags[i])
    }
  }
}

'%do%' <- function(obj, ex) {
  doSEQ(obj, substitute(ex), parent.frame())
}

'%dopar%' <- function(obj, ex) {
  e <- getDoPar()
  e$fun(obj, substitute(ex), parent.frame(), e$data)
}

'%doSMP%' <- function(obj, ex) {
	e<- getDoSMP()
	e$fun(obj, substitute(ex), parent.frame(), e$data)
}

comp <- if (getRversion() < "2.13.0") {
  function(expr, ...) expr
} else {
  compiler::compile
}

doSEQ <- function(obj, expr, envir, data) {
  # note that the "data" argument isn't used
  if (!inherits(obj, 'foreach'))
    stop('obj must be a foreach object')

  it <- iter(obj)
  accumulator <- makeAccum(it)

  for (p in obj$packages)
    library(p, character.only=TRUE)

  # compile the expression if we're using R 2.13.0 or greater
  xpr <- comp(expr, env=envir, options=list(suppressUndefined=TRUE))

  i <- 1
  tryCatch({
    repeat {
      # get the next set of arguments
      args <- nextElem(it)
      if (obj$verbose) {
        cat(sprintf('evaluation # %d:\n', i))
        print(args)
      }

      # assign arguments to local environment
      for (a in names(args))
        assign(a, args[[a]], pos=envir, inherits=FALSE)

      # evaluate the expression
      r <- tryCatch(eval(xpr, envir=envir), error=function(e) e)
      if (obj$verbose) {
        cat('result of evaluating expression:\n')
        print(r)
      }

      # process the results
      tryCatch(accumulator(list(r), i), error=function(e) {
        cat('error calling combine function:\n')
        print(e)
        NULL
      })
      i <- i + 1
    }
  },
  error=function(e) {
    if (!identical(conditionMessage(e), 'StopIteration'))
      stop(simpleError(conditionMessage(e), expr))
  })

  errorValue <- getErrorValue(it)
  errorIndex <- getErrorIndex(it)

  if (identical(obj$errorHandling, 'stop') && !is.null(errorValue)) {
    msg <- sprintf('task %d failed - "%s"', errorIndex,
                   conditionMessage(errorValue))
    stop(simpleError(msg, call=expr))
  } else {
    getResult(it)
  }
}